R Notebook

library(tidyverse)
library(ggdendro)
library(here)
library(plotly)
library(cluster)
library(ggfortify)
library(broom)
source(here::here("code/plota_solucoes_hclust.R"))

games = read_csv("../data/international-football.csv")

Parsed with column specification:
cols(
  date = col_date(format = ""),
  home_team = col_character(),
  away_team = col_character(),
  home_score = col_integer(),
  away_score = col_integer(),
  tournament = col_character(),
  city = col_character(),
  country = col_character(),
  neutral = col_logical()
)

jogos_brasil = games %>% 
    filter(home_team == "Brazil" | away_team == "Brazil") %>% 
    mutate(time1 = "Brazil", 
           time2 = if_else(home_team == "Brazil", away_team, home_team), 
           score1 = if_else(home_team == "Brazil", home_score, away_score),
           score2 = if_else(home_team == "Brazil", away_score, home_score) 
    ) 
historicos = jogos_brasil %>% 
    group_by(time2) %>% 
    summarise(
        jogos = n(),
        ganhou = sum(score1 > score2) / n(), 
        empatou = sum(score1 == score2) / n(),
        perdeu = sum(score1 < score2) / n()
        )

p <- historicos %>%
  filter(jogos > 2) %>%
  ggplot(aes(x = ganhou, 
             y = jogos, 
             text = paste("Seleção:", time2,
                          "\nVitorio:",ganhou,
                          "\nPerdeu:",perdeu,
                          "\nEmpatou:",empatou))) + 
  geom_point(size = 4,
             color = "#938BA1") +
  labs(y = "Quantidade de Jogos", 
       x = "Proporção de Vitorias.")
ggplotly(p, tooltip = "text") %>%
    layout(autosize = F)

We recommend that you use the dev version of ggplot2 with `ggplotly()`
Install it with: `devtools::install_github('hadley/ggplot2')`

• Podemos observar que o Brasil tende a ter um numero maior de vitorias.
• Os times que o Brasil mais jogou são times da america latina podemos associar isto aos campeonatos classificatorio para copa do mundo.
• Para está analise consideramos apenas seleções que o Brasil jogou mais do que 2 vezes.

agrupamento_h = historicos %>% 
    filter(jogos > 2) %>%
    as.data.frame() %>% 
    column_to_rownames("time2") %>% 
    select(ganhou) %>%
    dist(method = "euclidian") %>% 
    hclust(method = "ward.D")
ggdendrogram(agrupamento_h, rotate = T, size = 2, theme_dendro = F) + 
    labs(y = "Dissimilaridade", x = "", title = "Dendrograma")

• Podemos observar em termo de Dissimilaridade a divisão de grupos bem proximas.

Aplicando o K-means

Com o intuito de busca grupos onde se encaixa os adversarios da seleção Brasileira podemos observar utilizando o algoritimo k-means.

*O algoritmo do K-Means pode ser descrito da seguinte maneira: +1: Escolher k distintos valores para centros dos grupos (possivelmente, de forma aleatória) +2: Associar cada ponto ao centro mais próximo +3: Recalcular o centro de cada grupo +4: Repetir os passos 2-3 até nenhum elemento mudar de grupo.

historico_t = historicos %>% 
    filter(jogos > 2) %>% 
    mutate(jogos = log10(jogos)) 
atribuicoes = tibble(k = 1:6) %>% 
    group_by(k) %>% 
    do(kmeans(select(historico_t,ganhou, jogos), 
              centers = .$k, 
              nstart = 10) %>% augment(historico_t)) # alterne entre filmes e filmes_t no augment  

Unequal factor levels: coercing to characterbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vector

atribuicoes_long = atribuicoes %>% 
    gather(key = "variavel", value = "valor", -time2, -k, -.cluster, -jogos) 
atribuicoes %>%
    ggplot(aes(x = ganhou, y = jogos, label = time2, colour = .cluster)) + 
    geom_point() + 
    #geom_text() + 
    facet_wrap(~ k) + scale_y_log10()

# A silhoueta
dists = select(historico_t, ganhou, jogos) %>% dist()
km = kmeans(select(historico_t, ganhou, jogos), 
            centers = 4, 
            nstart = 10) 
silhouette(km$cluster, dists) %>% 
    plot(col = RColorBrewer::brewer.pal(4, "Set2"))

• Podemos observar que a divisão em 5 grupo como a ideal.
• Considerando o uso do k-means podemos verificar qual o melhor valor de k de acordo com o gráfico abaixo.

set.seed(123)
explorando_k = tibble(k = 1:15) %>% 
    group_by(k) %>% 
    do(
        kmeans(select(historico_t, -time2), 
               centers = .$k, 
               nstart = 20) %>% glance()
    )
explorando_k %>% 
    ggplot(aes(x = k, y = betweenss / totss)) + 
    geom_line() + 
    geom_point()

• Podemos observar que k está entre os valores 5 e 6.

• Consideramos que á partir do valor 6 não ocorre uma mudança considerada na linha da curva então podemos considerar k = 5.

• Organizando os dados segundo os grupos identificados:

d.scaled.km.long = km %>% 
    augment(historico_t) %>%
    gather(key = "variável", 
           value = "valor", 
           -time2, -.cluster)

d.scaled.km.long %>% 
    ggplot(aes(x=`variável`, y=valor, group=time2, colour=.cluster)) + 
    geom_line(alpha = .5) + 
    facet_wrap(~ .cluster) 

• Vamos identificar esses grupos:
• O grupo 1 podemos verificar que é constituido por times onde o Brasil mais jogou contra.
• O grupo 2 observamos que o Brasil jogou um número considerado de partidas e tem um número de vitorias bem contra esses times.
• O grupo 3 Consideramos que é o grupo onde tem seleções que o Brasil mais perdeu.
• O grupo 4 observamos que é os “fregueses” do Brasil pós é as seleções que mais perderam para o Brasil.